KeepLines Subroutine

public subroutine KeepLines(fileUnit, lines, pos, header)

Erase lines except the number specified as argument. pos defines wheter kept lines are counted starting from the beginning or from the end of file. Optional argument header defines number of lines at the beginning of the file to be considered as header. Header lines are never deleted. Manipulated file is supposed to be already opened.

Arguments

Type IntentOptional Attributes Name
integer(kind=short), intent(in) :: fileUnit
integer(kind=short), intent(in) :: lines
character(len=*), intent(in) :: pos

possible value: first, last
integer(kind=short), intent(in), optional :: header

Variables

Type Visibility Attributes Name Initial
integer(kind=short), public :: countLines
character(len=300), public :: fileName
type(varying_string), public, ALLOCATABLE :: headerBuffer(:)
integer(kind=short), public :: i
integer(kind=short), public :: ios
character(len=1), public :: junk
type(varying_string), public, ALLOCATABLE :: linesBuffer(:)

Source Code

SUBROUTINE KeepLines &
!
(fileUnit, lines, pos, header)

IMPLICIT NONE

!Arguments with intent(in):
INTEGER (KIND = short), INTENT(IN) :: fileUnit
INTEGER (KIND = short), INTENT(IN) :: lines
CHARACTER (LEN = *), INTENT(IN) :: pos !!possible value: first, last
INTEGER (KIND = short), OPTIONAL, INTENT(IN) :: header 

! Local declarations:  
TYPE (varying_string), ALLOCATABLE :: headerBuffer (:)
TYPE (varying_string), ALLOCATABLE :: linesBuffer (:)
INTEGER (KIND = short) :: i
INTEGER (KIND = short) :: ios
INTEGER (KIND = short) :: countLines
CHARACTER (LEN = 1) :: junk
CHARACTER (LEN = 300) :: fileName
!------------end of declaration------------------------------------------------

IF (PRESENT (header)) THEN
  ALLOCATE (headerBuffer (header))
END IF

ALLOCATE (linesBuffer (lines))

!rewind file before counting lines
REWIND (fileUnit)

!count number of lines in the file
countLines = 0
DO 
  READ(fileUnit,*,IOSTAT=ios) junk
  countLines = countLines + 1
  IF (ios /= 0) EXIT
END DO

IF (PRESENT (header)) THEN
  IF (countLines < lines + header) THEN
     INQUIRE (UNIT=fileUnit, NAME=fileName)
     CALL Catch ('info', 'FileSys',  &
       'current number of lines less than maximum in file: ', &
       argument = TRIM(fileName)  )
     RETURN
  END IF
ELSE
  IF (countLines < lines) THEN
     INQUIRE (UNIT=fileUnit, NAME=fileName)
     CALL Catch ('info', 'FileSys',  &
       'current number of lines less than maximum in file: ', &
       argument = TRIM(fileName)  )
     RETURN
  END IF
END IF

!rewind file before reading
REWIND (fileUnit)

IF (PRESENT(header)) THEN
    countLines = countLines - header
    DO i =1, header
      CALL Get (unit = fileUnit, string = headerBuffer(i))
    END DO
END IF

IF (pos == 'first') THEN
    DO i =1, lines
      CALL Get (unit = fileUnit, string = linesBuffer(i))
    END DO
ELSE
    DO i = 1, countLines - lines
        READ(fileUnit,*) junk
    END DO
    
     DO i =1, lines
      CALL Get (unit = fileUnit, string = linesBuffer(i))
    END DO
    
END IF


!rewind file before writing
REWIND (fileUnit)

!overwrite file
IF (PRESENT(header)) THEN
   DO i =1, header
      CALL Put_line (unit = fileUnit, string = headerBuffer(i))
    END DO
END IF

DO i =1, lines
   CALL Put_line (unit = fileUnit, string = linesBuffer(i))
END DO




!release memory
DEALLOCATE (headerBuffer)
DEALLOCATE (linesBuffer)


END SUBROUTINE KeepLines